home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / rgb.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-12-21  |  2.1 KB  |  70 lines
  1. program RGB;
  2. {----------------------------------------------------------\
  3. | This program illustrates how to use the SetRGBPalette    |
  4. | command from the Turbo Pascal 5.0 Graph unit to create   |
  5. | 16 shades of gray on a VGA graphics card.                |
  6. |                                                          |
  7. | Author     : John Sieraski (Borland technical support)   |
  8. | Last update: 12/21/88                                    |
  9. | Ware-ness  : Released to the public domain by the author |
  10. \----------------------------------------------------------}
  11. uses
  12.   Crt, Graph;
  13.  
  14. function Int2Str(L : LongInt) : string;
  15. { Converts an integer to a string for use with OutText, OutTextXY }
  16. var
  17.   S : string;
  18. begin
  19.   Str(L, S);
  20.   Int2Str := S;
  21. end; { Int2Str }
  22.  
  23. procedure Wait;
  24. { Wait for key, then flush the buffer }
  25. var
  26.   Ch : char;
  27. begin
  28.   Ch := ReadKey;
  29.   while KeyPressed do
  30.     Ch := ReadKey;
  31. end; { Wait }
  32.  
  33. var
  34.   Driver, Mode, ErrorCode, BarHeight, Y : integer;
  35.   PalIndex : byte;
  36.  
  37. begin
  38.   Driver := VGA;                    { Initialize VGA 640x480 graphics mode }
  39.   Mode := VGAHi;
  40.   InitGraph(Driver, Mode, '');      { Assumes EGAVGA.BGI in default dir }
  41.   ErrorCode := GraphResult;
  42.   if ErrorCode <> grOK then
  43.   begin
  44.     Writeln('Error: ', GraphErrorMsg(ErrorCode));
  45.     Wait; Halt;
  46.   end;
  47.  
  48.   for PalIndex := 0 to 15 do        { Set raw colors in palette so that }
  49.     SetPalette(PalIndex, PalIndex); { they're in sequence from 0..15    }
  50.  
  51.  
  52.   for PalIndex := 0 to 15 do        { Create gray scale in DACs 0..15 }
  53.     SetRGBPalette(PalIndex, PalIndex*4, PalIndex*4, PalIndex*4);
  54.  
  55.   BarHeight := GetMaxY div 16;      { Display the gray scale }
  56.   Y := 0;
  57.   SetColor(GetMaxColor);            { Color for 1st 8 OutText calls in loop }
  58.   for PalIndex := 0 to 15 do
  59.   begin
  60.     SetFillStyle(SolidFill, PalIndex);
  61.     Bar(0, Y, GetMaxX, Y+BarHeight);
  62.     if PalIndex = 8 then
  63.       SetColor(0);                  { Color for last 8 OutText calls }
  64.     OutTextXY(10,  Y+(BarHeight div 2), Int2Str(PalIndex));
  65.     Inc(Y, BarHeight);
  66.   end;
  67.  
  68.   Wait; CloseGraph;
  69. end.
  70.